Here, we’re just setting a few options.

knitr::opts_chunk$set(
  warning = TRUE, # show warnings during codebook generation
  message = TRUE, # show messages during codebook generation
  error = TRUE, # do not interrupt codebook generation in case of errors,
                # usually better for debugging
  echo = TRUE  # show R code
)
ggplot2::theme_set(ggplot2::theme_bw())
pander::panderOptions("table.split.table", Inf)

Now, we’re preparing our data for the codebook.

library(codebook)
library(labelled)
library(tidyverse)

## ── Attaching packages ─────────────────────────────────────────────────── tidyverse 1.2.1 ──

## ✔ ggplot2 3.0.0     ✔ purrr   0.2.5
## ✔ tibble  1.4.2     ✔ dplyr   0.7.6
## ✔ tidyr   0.8.1     ✔ stringr 1.3.1
## ✔ readr   1.1.1     ✔ forcats 0.3.0

## ── Conflicts ────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

codebook_data <- rio::import("https://osf.io/s87kd/download", "csv")
dict <- rio::import("https://osf.io/cs678/download", "csv")

var_label(codebook_data) <- dict %>% select(variable, label) %>% dict_to_list()

val_labels(codebook_data$gender) <- c("male" = 1, "female" = 2)
val_labels(codebook_data$education) <- c("in high school" = 1,
   "finished high school" = 2,
              "some college" = 3, 
               "college graduate" = 4, 
              "graduate degree" = 5)
            
add_likert_labels <- function(x) {
  val_labels(x) <- c("Very Inaccurate" = 1L, 
                  "Moderately Inaccurate" = 2L, 
                  "Slightly Inaccurate" = 3L,
                  "Slightly Accurate" = 4L,
                  "Moderately Accurate" = 5L,
                  "Very Accurate" = 6L)
  x
}

likert_items <- dict %>% filter(Big6 != "") %>% pull(variable)

codebook_data <- codebook_data %>% mutate_at(likert_items,  add_likert_labels)

codebook_data$extraversion <- codebook_data %>% select(E1:E5) %>% aggregate_and_document_scale()

# omit the following lines, if your missing values are already properly labelled
codebook_data <- detect_missing(codebook_data,
    only_labelled = TRUE, # only labelled values are autodetected as
                                   # missing
    negative_values_are_missing = FALSE, # negative values are missing values
    ninety_nine_problems = TRUE,   # 99/999 are missing values, if they
                                   # are more than 5 MAD from the median
    )

# If you are not using formr, the codebook package needs to guess which items
# form a scale. The following line finds item aggregates with names like this:
# scale = scale_1 + scale_2R + scale_3R
# identifying these aggregates allows the codebook function to
# automatically compute reliabilities.
# However, it will not reverse items automatically.
codebook_data <- detect_scales(codebook_data)

## Warning in detect_scales(codebook_data): A items found, but no aggregate

## Warning in detect_scales(codebook_data): C items found, but no aggregate

## Warning in detect_scales(codebook_data): E items found, but no aggregate

## Warning in detect_scales(codebook_data): N items found, but no aggregate

## Warning in detect_scales(codebook_data): O items found, but no aggregate

Create codebook

codebook(codebook_data)

## Warning in codebook(codebook_data): The variables session, created, ended
## have to be defined for automatic survey repetition detection to work. Set
## to no repetition by default.

## Warning in psych::alpha(as.data.frame(results[, scale_item_names]), title = scale_name, : Some items were negatively correlated with the total scale and probably 
## should be reversed.  
## To do this, run the function again with the 'check.keys=TRUE' option

## Some items ( E1 E2 ) were negatively correlated with the total scale and 
## probably should be reversed.

## To do this, run the function again with the 'check.keys=TRUE' option

knitr::asis_output(data_info)

Metadata

Description

if (exists("name", meta)) {
  glue::glue(
    "__Dataset name__: {name}",
    .envir = meta)
}

Dataset name: codebook_data

cat(description)

Dimensions

The dataset has N=2800 rows and 29 columns. 2236 rows have no missing values on any column.

Date published: 2018-10-16

meta <- meta[setdiff(names(meta),
                     c("creator", "datePublished", "identifier",
                       "url", "citation", "spatialCoverage", 
                       "temporalCoverage", "description", "name"))]
pander::pander(meta)

keywords: A1, A2, A3, A4, A5, C1, C2, C3, C4, C5, E1, E2, E3, E4, E5, N1, N2, N3, N4, N5, O1, O2, O3, O4, O5, gender, education, age and extraversion

knitr::asis_output(survey_overview)

Variables

knitr::asis_output(paste0(scales_items, sep = "\n\n\n", collapse = "\n\n\n"))

A1

Am indifferent to the feelings of others.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

16 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
A1	Am indifferent to the feelings of others.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	16	2784	2800	6	1: 922, 2: 818, 3: 402, 4: 337

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

A2

Inquire about others’ well-being.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

27 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
A2	Inquire about others’ well-being.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	27	2773	2800	6	5: 1023, 6: 873, 4: 553, 3: 151

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

A3

Know how to comfort others.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

26 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
A3	Know how to comfort others.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	26	2774	2800	6	5: 986, 6: 755, 4: 564, 3: 207

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

A4

Love children.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

19 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
A4	Love children.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	19	2781	2800	6	6: 1147, 5: 654, 4: 451, 2: 215

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

A5

Make people feel at ease.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

16 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
A5	Make people feel at ease.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	16	2784	2800	6	5: 973, 6: 695, 4: 617, 3: 254

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

C1

Am exacting in my work.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

21 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
C1	Am exacting in my work.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	21	2779	2800	6	5: 1018, 4: 655, 6: 597, 3: 275

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

C2

Continue until everything is perfect.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

24 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
C2	Continue until everything is perfect.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	24	2776	2800	6	5: 962, 4: 643, 6: 550, 3: 296

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

C3

Do things according to a plan.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

20 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
C3	Do things according to a plan.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	20	2780	2800	6	5: 942, 4: 741, 6: 472, 3: 293

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

C4

Do things in a half-way manner.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

26 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
C4	Do things in a half-way manner.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	26	2774	2800	6	2: 794, 1: 769, 3: 472, 4: 448

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

C5

Waste my time.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

16 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
C5	Waste my time.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	16	2784	2800	6	4: 614, 2: 567, 1: 504, 5: 466

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

N1

Get angry easily.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

22 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
N1	Get angry easily.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	22	2778	2800	6	1: 654, 2: 654, 4: 515, 3: 427

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

N2

Get irritated easily.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

21 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
N2	Get irritated easily.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	21	2779	2800	6	4: 709, 2: 535, 5: 510, 3: 411

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

N3

Have frequent mood swings.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

11 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
N3	Have frequent mood swings.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	11	2789	2800	6	2: 638, 4: 591, 1: 499, 5: 439

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

N4

Often feel blue.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

36 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
N4	Often feel blue.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	36	2764	2800	6	2: 655, 4: 608, 1: 472, 3: 401

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

N5

Panic easily.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

29 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
N5	Panic easily.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	29	2771	2800	6	2: 660, 1: 654, 4: 507, 3: 382

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

O1

Am full of ideas.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

22 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
O1	Am full of ideas.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	22	2778	2800	6	5: 925, 6: 912, 4: 606, 3: 210

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

O2

Avoid difficult reading material.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

0 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
O2	Avoid difficult reading material.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	0	2800	2800	6	1: 805, 2: 717, 4: 435, 3: 388

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

O3

Carry the conversation to a higher level.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

28 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
O3	Carry the conversation to a higher level.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	28	2772	2800	6	5: 943, 4: 775, 6: 541, 3: 292

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

O4

Spend time reflecting on things.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

14 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
O4	Spend time reflecting on things.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	14	2786	2800	6	6: 1084, 5: 887, 4: 481, 3: 154

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

O5

Will not probe deeply into a subject.

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

20 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
O5	Will not probe deeply into a subject.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	20	2780	2800	6	2: 883, 1: 746, 3: 526, 4: 364

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Very Inaccurate: 1
Moderately Inaccurate: 2
Slightly Inaccurate: 3
Slightly Accurate: 4
Moderately Accurate: 5
Very Accurate: 6

gender

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

0 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
gender	gender	labelled	FALSE	1. male, 2. female	0	2800	2800	2	2: 1881, 1: 919, NA: 0

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

male: 1
female: 2

education

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

223 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
education	education	labelled	FALSE	1. in high school, 2. finished high school, 3. some college, 4. college graduate, 5. graduate degree	223	2577	2800	5	3: 1249, 5: 418, 4: 394, 2: 292

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

Value labels

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

in high school: 1
finished high school: 2
some college: 3
college graduate: 4
graduate degree: 5

age

Distribution

show_missing_values <- FALSE
if (has_labels(item)) {
  missing_values <- item[is.na(haven::zap_missing(item))]
  attributes(missing_values) <- attributes(item)
  if (!is.null(attributes(item)$labels)) {
    attributes(missing_values)$labels <- attributes(missing_values)$labels[is.na(attributes(missing_values)$labels)]
    attributes(item)$labels <- attributes(item)$labels[!is.na(attributes(item)$labels)]
  }
  if (is.double(item)) {
    show_missing_values <- length(unique(haven::na_tag(missing_values))) > 1
    item <- haven::zap_missing(item)
  }
  if (length(item_attributes$labels) == 0 && is.numeric(item)) {
    item <- haven::zap_labels(item)
  }
}
item_nomiss <- item[!is.na(item)]

# unnest mc_multiple and so on
if (
  is.character(item_nomiss) &&
  stringr::str_detect(item_nomiss, stringr::fixed(", ")) &&
  (exists("type", item_info) && 
    stringr::str_detect(item_info$type, pattern = stringr::fixed("multiple")))
  ) {
  item_nomiss <- unlist(stringr::str_split(item_nomiss, pattern = stringr::fixed(", ")))
}
attributes(item_nomiss) <- attributes(item)

old_height <- knitr::opts_chunk$get("fig.height")
non_missing_choices <- item_attributes[["labels"]]
many_labels <- length(non_missing_choices) > 7
go_vertical <- !is.numeric(item_nomiss) || many_labels
if ( go_vertical ) {
  # numeric items are plotted horizontally (because that's what usually expected)
  # categorical items are plotted vertically because we can use the screen real estate better this way

    if (is.null(choices) || 
        dplyr::n_distinct(item_nomiss) > length(non_missing_choices)) {
        non_missing_choices <- unique(item_nomiss)
        names(non_missing_choices) <- non_missing_choices
    }
  choice_multiplier <- old_height/6.5
    new_height <- 2 + choice_multiplier * length(non_missing_choices)
    new_height <- ifelse(new_height > 20, 20, new_height)
    new_height <- ifelse(new_height < 1, 1, new_height)
    knitr::opts_chunk$set(fig.height = new_height)
}

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

# todo: if there are free-text choices mingled in with the pre-defined ones, don't show
# todo: show rare items if they are pre-defined
# todo: bin rare responses into "other category"
if (!length(item_nomiss)) {
  cat("No non-missing values to show.")
} else if (is.numeric(item_nomiss) || dplyr::n_distinct(item_nomiss) < 20) {
  plot_labelled(item_nomiss, item_name, wrap_at, go_vertical)
} else {
    cat(dplyr::n_distinct(item_nomiss), " unique, categorical values, so not shown.")
}

knitr::opts_chunk$set(fig.height = old_height)

0 missing values.

Summary statistics

attributes(item) <- item_attributes
df = data.frame(item, stringsAsFactors = FALSE)
names(df) = html_item_name
escaped_table(codebook_table(df))

name	label	data_type	missing	complete	n	mean	sd	p0	p25	p50	p75	p100	hist
age	age	integer	0	2800	2800	28.78	11.13	3	20	26	35	86	▁▇▆▃▂▁▁▁

if (show_missing_values) {
  plot_labelled(missing_values, item_name, wrap_at)
}

if (!is.null(item_info)) {
  # don't show choices again, if they're basically same thing as value labels
  if (!is.null(choices) && !is.null(item_info$choices) && 
    all(names(na.omit(choices)) == item_info$choices) &&
    all(na.omit(choices) == names(item_info$choices))) {
    item_info$choices <- NULL
  }
  item_info$label_parsed <- 
    item_info$choice_list <- item_info$study_id <- item_info$id <- NULL
  pander::pander(item_info)
}

if (!is.null(choices) && length(choices) && length(choices) < 30) {
    pander::pander(as.list(choices))
}

Scale: extraversion

Overview

Reliability: Cronbach’s α [95% CI] = -0.63 [-0.73;-0.53].

Missing: 87.

old_height <- knitr::opts_chunk$get("fig.height")
new_height <- length(scale_info$scale_item_names)
new_height <- ifelse(new_height > 20, 20, new_height)
new_height <- ifelse(new_height < 1, 1, new_height)
new_height <- ifelse(is.na(new_height) | is.nan(new_height), 
                     old_height, new_height)
knitr::opts_chunk$set(fig.height = new_height)

likert_plot <- likert_from_items(items)
if (!is.null(likert_plot)) {
  graphics::plot(likert_plot)
}

knitr::opts_chunk$set(fig.height = old_height)

binwidth <- mean(diff(sort(unique(scale))))

wrap_at <- knitr::opts_chunk$get("fig.width") * 10

dist_plot <- plot_labelled(scale, scale_name, wrap_at)

choices <- attributes(items[[1]])$item$choices
breaks <- as.numeric(names(choices))
if (length(breaks)) {
  suppressMessages( # ignore message about overwriting x axis
  dist_plot <- dist_plot +
        ggplot2::scale_x_continuous("values", 
                                breaks = breaks, 
                                labels = stringr::str_wrap(unlist(choices), ceiling(wrap_at * 0.21))) +
      ggplot2::expand_limits(x = range(breaks)))
  
}

dist_plot

Reliability details

for (i in seq_along(reliabilities)) {
  rel <- reliabilities[[i]]
  cat(knitr::knit_print(rel, indent = paste0(indent, "####")))
}

Reliability

95% Confidence Interval

if (!is.null(x$total$ase)) {
  pander::pander(data.frame(lower = x$total$raw_alpha - 1.96 * x$total$ase, 
             estimate = x$total$raw_alpha, 
             upper = x$total$raw_alpha + 1.96 * 
  x$total$ase))
}

lower	estimate	upper
-0.7345	-0.633	-0.5315

pander::pander(x$total)

raw_alpha	std.alpha	G6(smc)	average_r	S/N	ase	mean	sd	median_r
-0.633	-0.5144	0.01189	-0.07289	-0.3397	0.05179	3.792	0.5431	-0.3139

Reliability if an item is dropped:

rownames(x$alpha.drop) <- recursive_escape(rownames(x$alpha.drop))
pander::pander(x$alpha.drop)

	raw_alpha	std.alpha	G6(smc)	average_r	S/N	alpha se	var.r	med.r
E1	-0.2685	-0.108	0.2249	-0.02498	-0.09749	0.03784	0.1935	-0.02859
E2	-0.0806	0.04624	0.2646	0.01197	0.04848	0.03314	0.1589	0.007046
E3	-0.8804	-0.9366	-0.2199	-0.1375	-0.4836	0.05953	0.1752	-0.3376
E4	-0.4332	-0.4811	-0.01814	-0.08838	-0.3248	0.04544	0.16	-0.3139
E5	-0.7785	-0.8052	-0.1202	-0.1255	-0.4461	0.05732	0.1982	-0.353

Item statistics

rownames(x$item.stats) <- recursive_escape(rownames(x$item.stats))
pander::pander(x$item.stats)

	n	raw.r	std.r	r.cor	r.drop	mean	sd
E1	2777	0.3457	0.2237	-1.458	-0.2675	2.974	1.632
E2	2784	0.2268	0.1059	-2.053	-0.3554	3.142	1.605
E3	2775	0.4939	0.5825	1.779	-0.008283	4.001	1.353
E4	2791	0.3478	0.4258	0.7463	-0.2016	4.422	1.458
E5	2779	0.4537	0.5442	1.191	-0.04674	4.416	1.335

Non missing response frequency for each item

rownames(x$response.freq) <- recursive_escape(rownames(x$response.freq))
pander::pander(x$response.freq)

	1	2	3	4	5	6	miss
E1	0.2387	0.2348	0.1455	0.162	0.1322	0.08678	0.008214
E2	0.1915	0.2407	0.1232	0.2152	0.1383	0.09124	0.005714
E3	0.05369	0.1056	0.1485	0.2977	0.2677	0.1268	0.008929
E4	0.05016	0.09387	0.0971	0.1612	0.3375	0.2601	0.003214
E5	0.03418	0.07953	0.1036	0.2227	0.3383	0.2217	0.0075

Summary statistics

for (i in seq_along(names(items))) {
  attributes(items[[i]]) = recursive_escape(attributes(items[[i]]))
}
escaped_table(codebook_table(items))

name	label	data_type	ordered	value_labels	missing	complete	n	n_unique	top_counts
E1	Don’t talk a lot.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	23	2777	2800	6	1: 663, 2: 652, 4: 450, 3: 404
E2	Find it difficult to approach others.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	16	2784	2800	6	2: 670, 4: 599, 1: 533, 5: 385
E3	Know how to captivate people.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	25	2775	2800	6	4: 826, 5: 743, 3: 412, 6: 352
E4	Make friends easily.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	9	2791	2800	6	5: 942, 6: 726, 4: 450, 3: 271
E5	Take charge.	labelled	FALSE	1. Very Inaccurate, 2. Moderately Inaccurate, 3. Slightly Inaccurate, 4. Slightly Accurate, 5. Moderately Accurate, 6. Very Accurate	21	2779	2800	6	5: 940, 4: 619, 6: 616, 3: 288

missingness_report

Missingness report

Among those who finished the survey. Only variables that have missing values are shown.

if (  exists("ended", results) &&
  exists("expired", results)) {
  finisher_results <- dplyr::filter(results, !is.na(.data$ended))
} else {
  finisher_results <- results
  warning("Could not figure out who finished the surveys, because the ",
          "variables expired and ended were missing.")
}

## Warning: Could not figure out who finished the surveys, because the
## variables expired and ended were missing.

if (length(md_pattern)) {
  pander::pander(md_pattern)
}

description	E4	N3	O4	A1	A5	C5	E2	A4	C3	O5	C1	E5	N2	N1	O1	E1	C2	E3	A3	C4	A2	O3	N5	N4	extraversion	education	var_miss	n_miss
Missing values in 0 variables	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	0	2236
Missing values per variable	9	11	14	16	16	16	16	19	20	20	21	21	21	22	22	23	24	25	26	26	27	28	29	36	87	223	818	818
Missing values in 1 variables	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	0	1	200
99 other, less frequent patterns	95	92	93	90	93	93	92	87	87	88	93	94	92	89	90	91	86	87	87	87	87	83	86	87	68	80	277	364

items

Codebook table

export_table(metadata_table)

jsonld